PC Users 1998 March/Pc Users extra 6.iso/pshare95/prog/formula1/vcform1.z/ReportWriter.frm

Visual Basic Form | 1997-09-17 | 7.5 KB | 225 lines

VERSION 5.00
Object = "{13E51000-A52B-11D0-86DA-00608CB9FBFB}#5.0#0"; "VCF15.OCX"
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.1#0"; "COMDLG32.OCX"
Begin VB.Form ReportWriter
   BackColor       =   &H00C0C0C0&
   Caption         =   "Report Writer"
   ClientHeight    =   7935
   ClientLeft      =   165
   ClientTop       =   510
   ClientWidth     =   11325
   Icon            =   "ReportWriter.frx":0000
   LinkTopic       =   "Form1"
   ScaleHeight     =   7935
   ScaleWidth      =   11325
   StartUpPosition =   2  'CenterScreen
   Begin VB.CommandButton btnViewReport
      Caption         =   "&View Report"
      Height          =   480
      Left            =   15
      TabIndex        =   2
      Top             =   3900
      Visible         =   0   'False
      Width           =   1815
   End
   Begin VB.ListBox lstFields
      DragIcon        =   "ReportWriter.frx":000C
      Height          =   3765
      Left            =   15
      TabIndex        =   1
      Top             =   75
      Visible         =   0   'False
      Width           =   2835
   End
   Begin MSComDlg.CommonDialog CommonDialog1
      Left            =   10770
      Top             =   330
      _ExtentX        =   847
      _ExtentY        =   847
      _Version        =   327680
   End
   Begin VCF150Ctl.F1Book F1Book1
      Height          =   7830
      Left            =   15
      TabIndex        =   0
      Top             =   60
      Width           =   11295
      _ExtentX        =   19923
      _ExtentY        =   13811
      _0              =   $"ReportWriter.frx":0156
      _1              =   $"ReportWriter.frx":055B
      _2              =   $"ReportWriter.frx":0960
      _3              =   $"ReportWriter.frx":0D65
      _4              =   $"ReportWriter.frx":116A
      _count          =   5
      _ver            =   1
   End
   Begin VB.Line Line2
      BorderColor     =   &H80000005&
      X1              =   -45
      X2              =   11280
      Y1              =   15
      Y2              =   15
   End
   Begin VB.Line Line1
      BorderColor     =   &H80000003&
      X1              =   -60
      X2              =   11280
      Y1              =   0
      Y2              =   0
   End
   Begin VB.Menu mnuFile
      Caption         =   "&File"
      Begin VB.Menu mnuFileNewReport
         Caption         =   "&New Report"
      End
      Begin VB.Menu mnuFileOpen
         Caption         =   "&Open"
         Begin VB.Menu mnuFileOpenDatabase
            Caption         =   "&Database"
         End
         Begin VB.Menu mnuFileOpenReport
            Caption         =   "&Report"
         End
      End
      Begin VB.Menu mnuFilePrint
         Caption         =   "&Print"
      End
      Begin VB.Menu mnuFilePrintPreview
         Caption         =   "Print Pre&view"
      End
   End
   Begin VB.Menu mnuFormat
      Caption         =   "&Format"
      Begin VB.Menu mnuFormatCells
         Caption         =   "&Cells..."
      End
      Begin VB.Menu mnuFormatResizeColumns
         Caption         =   "&Resize Columns"
      End
   End
Attribute VB_Name = "ReportWriter"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub btnViewReport_Click()
    Dim RecordCount As Long
    Dim ColumnCoun As Long
    Dim RecSet As Recordset
    Dim nRow As Long
    Dim x As Integer
    Dim y As Integer
    Dim i As Integer
    Dim j As Integer
    Dim SQLFields As String
    nRow = 0
    With ReportWriter.F1Book1
        .ShowRowHeading = False
        .ShowColHeading = False
        .ShowGridLines = False
        .ShowSelections = F1Off
        .PrintGridLines = False

    End With

    For x = 1 To SQL.Fields.Count
        SQLFields = SQLFields & SQL.Fields.Item(x).Name & ", "
    Next x
    SQLFields = Left(SQLFields, Len(SQLFields) - 2)
    Set RecSet = dbs.OpenRecordset("Select " & SQLFields & " From " & SelectFields.cboTables.Text)
    RecSet.MoveLast
    RecSet.MoveFirst
    nRow = 0
    RecordCount = RecSet.RecordCount
    ColumnCount = RecSet.Fields.Count
    F1Book1.TextRC(RecordCount, ColumnCount) = "Test"
    F1Book1.TextRC(3, ColumnCount) = "Test"
    F1Book1.SetSelection 3, ColumnCount, RecordCount, ColumnCount
    F1Book1.EditCopyDown
    ReDim FieldPos(2, ColumnCount) As Long
    For x = 1 To ColumnCount
        For i = 1 To 256
            For j = 1 To 20
                If F1Book1.TextRC(j, i) = "{" & SQL.Fields(x).Name & "}" Then
                    FieldPos(1, x) = j
                    FieldPos(2, x) = i
                End If
            Next j
        Next i
    Next x
    For x = 1 To RecordCount
        For y = 0 To ColumnCount - 1
            If nRow >= ReportWriter.F1Book1.MaxRow Then
                Exit For
            End If
'            ReportWriter.F1Book1.TextRC(nRow, 1) = RecSet.Fields(y).Name
            If Not IsNull(RecSet.Fields(RecSet.Fields(y).Name).Value) Then
                ReportWriter.F1Book1.TextRC(FieldPos(1, y + 1) + nRow, FieldPos(2, y + 1)) = RTrim(RecSet.Fields(RecSet.Fields(y).Name).Value)
            End If
        Next y
        If nRow < ReportWriter.F1Book1.MaxRow Then
            nRow = nRow + 1
            ReportWriter.F1Book1.AddRowPageBreak nRow
        End If
        RecSet.MoveNext
    Next x
    ReportWriter.F1Book1.SetColWidthAuto -1, -1, -1, -1, False
    ReportWriter.F1Book1.SetRowHeightAuto -1, -1, -1, -1, False
    F1Book1.Left = F1Book1.Left - 2880
    F1Book1.Width = F1Book1.Width + 2880
    lstFields.Visible = False
    btnViewReport.Visible = False
End Sub
Private Sub F1Book1_DragDrop(Source As Control, x As Single, y As Single)
    Dim nRow As Long
    Dim nCol As Long
    F1Book1.TwipsToRC x, y, nRow, nCol
    F1Book1.TextRC(nRow, nCol) = "{" & Source.Text & "}"
    F1Book1.SetColWidthAuto -1, nCol, -1, nCol, False
    SQL.Fields.Add Source.Text, Source.Text
End Sub
Private Sub Form_Load()
    Set SQL = New SQLInfo
End Sub
Private Sub lstFields_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
    If Button = 1 Then
        lstFields.Drag 1
    End If
End Sub
Private Sub mnuFileNewReport_Click()
    F1Book1.InitTable
    Unload NewReport
    Unload SelectFields
    Unload Grouping
    Unload Sorting
    NewReport.Show 1
End Sub
Private Sub mnuFileOpenDatabase_Click()
    CommonDialog1.Filter = "*.mdb"
    CommonDialog1.ShowOpen
    ' Create Microsoft Jet Workspace object.
    Set wrkJet = CreateWorkspace("", "admin", "", dbUseJet)
    ' Open Database object from saved Microsoft Jet database.
    Set dbs = wrkJet.OpenDatabase(CommonDialog1.filename, False)
    ReportWriter.Caption = "Report Writer -- " & CommonDialog1.filename
End Sub
Private Sub mnuFilePrint_Click()
    F1Book1.FilePrintEx True, True
End Sub
Private Sub mnuFilePrintPreview_Click()
    F1Book1.FilePrintPreview
End Sub
Private Sub mnuFormatCells_Click()
    F1Book1.FormatCellsDlg F1AllPages
End Sub
Private Sub mnuFormatResizeColumns_Click()
    If F1Book1.ShowSelections = F1On Then
        F1Book1.ShowSelections = F1Off
    Else
        F1Book1.ShowSelections = F1On
    End If
    F1Book1.ShowColHeading = Not F1Book1.ShowColHeading
    F1Book1.SetFocus
End Sub